home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Belgian Amiga Club - ADF Collection
/
BS1 part 23.zip
/
BS1 part 23
/
Hisoft Basic v1.03 disk 2.adf
/
Drawing Programs
/
Paint.BAS
< prev
next >
Wrap
BASIC Source File
|
1988-12-02
|
18KB
|
748 lines
Setup:
Colors=5 : MaxColors=2^Colors-1
DIM Pointer(4,1),AltColor(4),Colors%(31,2)
DIM FillPattern%(7),AllPatterns%(8,7),Solid%(1)
DrawType=1 : DrawColor=1 : FillColor=2 : Mode=1
Solid%(0)=&HFFFF : Solid%(1)=&HFFFF
FOR x=0 TO 7
FillPattern%(x)=&HFFFF
AllPatterns%(0,x)=&HFFFF
NEXT x
FOR x=1 TO 8
FOR y=0 TO 7
READ AllPatterns%(x,y)
NEXT y
NEXT x
DATA 24672,1542,24672,1542,24672,1542,24672,1542
DATA -13108,13107,-13108,13107,-13108,13107,-13108,13107
DATA 26214,13107,-26215,-13108,26214,13107,-26215,-13108
DATA -13108,-26215,13107,26214,-13108,-26215,13107,26214
DATA -258,-258,-258,0,-4113,-4113,-4113,0
DATA -8185,-8197,-18019,-20491,-20467,-8197,-8185,-1
DATA 0,0,1632,4080,4080,2016,384,0
DATA 960,1984,3520,6592,16320,25024,-3104,0
SCREEN 1,320,200,Colors,1
WINDOW 2,"AmigaBASIC Draw Program",,16,1
WINDOW CLOSE 3
WINDOW CLOSE 4
WINDOW 2
FOR x=0 TO 31
READ r,g,b
PALETTE x,r/16,g/16,b/16
Colors%(x,0)=r : Colors%(x,1)=g : Colors%(x,2)=b
NEXT x
DATA 0,0,3, 15,15,15, 0,3,12, 15,0,0
DATA 0,14,15, 15,0,15, 3,10,1, 15,14,0
DATA 15,8,0, 10,0,14 ,8,5,0, 11,8,3
DATA 2,11,0, 15,10,15, 0,0,9, 7,15,0
DATA 14,12,0, 15,2,3, 0,0,0, 15,11,10
DATA 0,6,8, 3,3,3, 4,4,4, 5,5,5
DATA 6,6,6, 7,7,7, 8,8,8, 9,9,9
DATA 11,11,11, 13,13,13, 0,0,15, 12,15,12
Pulldown:
MENU 3,0,0,""
MENU 4,0,0,""
MENU 1,0,1,"Program"
MENU 1,1,1,"Draw "
MENU 1,2,1,"Color Palette"
MENU 1,3,1,"Fill Pattern "
MENU 1,4,1,"Load Screen "
MENU 1,5,1,"Save Screen "
MENU 1,6,1,"Clear Screen "
MENU 1,7,1,"End "
MENU 2,0,1,"Drawing tools"
MENU 2,1,2," Draw freehand "
MENU 2,2,1," Draw thick "
MENU 2,3,1," Points "
MENU 2,4,1," Spray "
MENU 2,5,1," Lines "
MENU 2,6,1," Frame "
MENU 2,7,1," Box "
MENU 2,8,1," Connected lines"
MENU 2,9,1," Oval "
MENU 2,10,1," Fill "
MENU 2,11,1," Eraser "
MENU 2,12,1," Text "
MainLoop:
ON MENU GOSUB MenuSelect
ON MOUSE GOSUB EvalMouse
MENU ON
MOUSE ON
WHILE -1
WEND
MenuSelect:
Men=MENU(0)
MenChoice=MENU(1)
ON Men GOTO Project,DrawTools
EvalMouse:
IF Mode=1 THEN ON DrawType GOSUB DrawThin,DrawThick,Points,Spray,DrawLines,Frame,Box,ConnectedLines,Oval,Fill,Eraser,Text
IF Mode=2 THEN GOSUB ColorPalette : IF EndOK=1 THEN GOSUB ColorDone
IF Mode=3 THEN GOSUB DefinePattern : IF EndOK=2 THEN GOSUB PatternDone
IF Mode=4 THEN GOSUB RGBDef : IF EndOK=3 THEN Mode=2 : GOSUB SelectColor
RETURN
Project:
IF MenChoice=1 THEN GOSUB ColorDone : GOSUB PatternDone
IF MenChoice=2 THEN GOSUB PatternDone : MENU 2,0,0 : Mode=2 : GOSUB SelectColor
IF MenChoice=3 THEN GOSUB ColorDone : MENU 2,0,0 : Mode=3 : GOSUB PatternEditor
IF MenChoice=4 THEN GOSUB ColorDone : GOSUB PatternDone : GOSUB DrawLoad
IF MenChoice=5 THEN GOSUB ColorDone : GOSUB PatternDone : GOSUB DrawSave
IF MenChoice=6 AND Mode=1 THEN OK=0 :GOSUB Query : IF OK=1 THEN Adef=0 : AREAFILL: CLS
IF MenChoice=7 THEN GOSUB ColorDone : GOSUB PatternDone : OK=0 : GOSUB Query : IF OK=1 THEN EndIt
RETURN
DrawTools:
MENU 2,DrawType,1
DrawType = MENU (1)
MENU 2,DrawType,2
RETURN
DrawThin:
Test= MOUSE(0) : x=MOUSE(1) : y=MOUSE(2)
WHILE MOUSE(0)<>0
LINE (x,y)-(MOUSE(1),MOUSE(2)),DrawColor
x=MOUSE(1) : y=MOUSE(2)
WEND
RETURN
DrawThick:
Test=MOUSE(0)
WHILE MOUSE(0)<>0
x=MOUSE(1) : y=MOUSE(2)
LINE (x,y)-(x+5,y+5),DrawColor,bf
WEND
RETURN
Points:
Test=MOUSE(0)
WHILE MOUSE(0)<>0
PSET (MOUSE(1),MOUSE(2)),DrawColor
WEND
RETURN
Spray:
Test=MOUSE(0)
WHILE MOUSE(0)<>0
x=MOUSE(1)+14*RND : y=MOUSE(2)+7*RND
LINE (x,y)-(x,y),DrawColor,bf
WEND
RETURN
DrawLines:
Test=MOUSE(0)
x1=MOUSE(3) : y1=MOUSE(4)
PSET (x1,y1),DrawColor
WHILE MOUSE(0)<>0
WEND
LINE (x1,y1)-(MOUSE(5),MOUSE(6)),DrawColor
RETURN
Frame:
Test=MOUSE(0)
x1=MOUSE(3) : y1=MOUSE(4)
Pointer(0,0)=x1 : Pointer(0,1)=y1
Pointer(1,0)=x1 : Pointer(2,1)=y1
Value=4
WHILE MOUSE(0)<>0
Pointer(3,0)=MOUSE(5)
Pointer(3,1)=MOUSE(6)
Pointer(1,1)=Pointer(3,1)
Pointer(2,0)=Pointer(3,0)
GOSUB PlacePoint
WEND
LINE (x1,y1)-(Pointer(3,0),Pointer(3,1)),DrawColor,b
RETURN
Box:
Test=MOUSE(0)
x1=MOUSE(3) : y1=MOUSE(4)
Pointer(0,0)=x1 : Pointer(0,1)=y1
Pointer(1,0)=x1 : Pointer(2,1)=y1
Value=4
WHILE MOUSE(0)<>0
Pointer(3,0)=MOUSE(5)
Pointer(3,1)=MOUSE(6)
Pointer(1,1)=Pointer(3,1)
Pointer(2,0)=Pointer(3,0)
GOSUB PlacePoint
WEND
LINE (x1,y1)-(Pointer(3,0),Pointer(3,1)),DrawColor,bf
RETURN
ConnectedLines:
Test=MOUSE(0)
x1=MOUSE(3) : y1=MOUSE(4)
IF y1>186 THEN y1=186
IF x1>311 THEN x1=311
AREA (x1,y1)
IF Adef=0 THEN Adef=1 : xa=x1 : ya=y1
IF Adef<>1 AND x1=xa AND y1=ya THEN DoFill
Adef=Adef+1 : IF Adef=20 THEN DoFill
LINE (xa,ya)-(x1,y1),DrawColor
xa=x1 : ya=y1
RETURN
DoFill:
Adef=0 : COLOR DrawColor,0 : AREAFILL
RETURN
Oval:
Test=MOUSE(0)
x1=MOUSE(3) : y1=MOUSE(4)
Pointer(0,0)=x1 : Pointer(0,1)=y1
Pointer(1,0)=x1 : Pointer(2,1)=y1
Pointer(3,0)=x1 : Pointer(4,1)=y1
Value=5
WHILE MOUSE(0)<>0
r1= ABS(x1-MOUSE(5))
r2= ABS(y1-MOUSE(6))
Pointer(1,1)=y1-r2 : Pointer(2,0)=x1+r1
Pointer(3,1)=y1+r2 : Pointer(4,0)=x1-r1
GOSUB PlacePoint
WEND
IF r1=0 THEN r1=.1
IF r1<r2 THEN Factor=(r2/r1) : r1=r1*Factor : r2=r2*Factor
CIRCLE (x1,y1),r1,DrawColor,,,(r2/r1)
RETURN
Fill:
Test=MOUSE(0)
IF Click=0 THEN
Click=1
SOUND 440,6,200
x=MOUSE(1) : y=MOUSE(2)
RETURN
ELSE
Click=0
IF ABS(x-MOUSE(1))<11 AND ABS(y-MOUSE(2))<6 THEN
PAINT (x,y),FillColor,DrawColor
ELSE
SOUND 440,6,200
END IF
END IF
RETURN
Eraser:
Test=MOUSE(0)
WHILE MOUSE(0)<>0
x=MOUSE(1):y=MOUSE(2)
PATTERN ,Solid%
LINE (x,y)-(x+10,y+5),0,bf
PATTERN ,FillPattern%
WEND
RETURN
Text:
Test=MOUSE(0)
x=MOUSE(1) : y=MOUSE(2)
MENU OFF : MOUSE OFF
MENU 1,0,0 : MENU 2,0,0
WINDOW 5,"Enter Text:",(0,177)-(311,185),18,1
CLS
LINE INPUT Text$
WINDOW CLOSE 5
WINDOW 2
MENU 1,0,1 : MENU 2,0,1
MENU ON : MOUSE ON
LOCATE INT(y/8.86)+1,INT(x/10)+1 : COLOR DrawColor,FillColor
PRINT Text$;
COLOR DrawColor,0
RETURN
PlacePoint:
FOR x=0 TO Value-1
xz=Pointer(x,0):yz=Pointer(x,1)
IF xz<0 THEN xz=0 : Pointer(x,0)=0
IF xz>311 THEN xz=311 : Pointer(x,0)=311
IF yz<0 THEN yz=0 : Pointer(x,1)=0
IF yz>186 THEN yz=186 : Pointer(x,1)=186
AltColor(x)=POINT(xz,yz)
NEXT x
FOR x=0 TO Value-1
PSET (Pointer(x,0),Pointer(x,1)),-(AltColor(x)=0)
NEXT x
FOR x=0 TO Value-1
PSET (Pointer(x,0),Pointer(x,1)),AltColor(x)
NEXT x
RETURN
SelectColor:
ColorChoice=0 : EndOK=0
MOUSE OFF : MENU OFF
WINDOW 3,"Color Palette",(4,20)-(245,160),18,1
PATTERN ,Solid%
FOR x= 1 TO (MaxColors+1)/8
FOR y= 0 TO 7
LINE (y*30,(x-1)*16)-((y+1)*30,x*16),(x-1)*8+y,bf
NEXT y
NEXT x
LINE (10,72)-(50,95),DrawColor,b
LINE (15,75)-(45,93),DrawColor,bf
LOCATE 12,2 : COLOR 0,1 : PRINT "Draw";
LINE (70,72)-(110,95),FillColor,b
LINE (75,75)-(105,93),FillColor,bf
LOCATE 12,8 : COLOR 1,0 : PRINT "Fill";
LINE (135,72)-(235,95),1,b
LOCATE 10,16: PRINT "Palette";
LINE (190,109)-(230,132),1,b
LOCATE 14,21 : PRINT "OK";
PATTERN ,FillPattern%
MOUSE ON : MENU ON
RETURN
ColorPalette:
Test=MOUSE(0)
x=MOUSE(3) : y=MOUSE(4)
GOSUB ChooseColor
PATTERN ,Solid%
LINE (10,72)-(50,95),DrawColor,b
LINE (15,75)-(45,93),DrawColor,bf
LINE (70,72)-(110,95),FillColor,b
LINE (75,75)-(105,93),FillColor,bf
PATTERN ,FillPattern%
IF WINDOW(0)=3 AND 72<y AND y<95 THEN
IF 70<x AND x<110 THEN ColorChoice=1
IF 10<x AND x<50 THEN ColorChoice=0
IF 135<x AND x<235 THEN
PATTERN ,Solid%
PAINT (137,74),3,1
PATTERN ,FillPattern%
GOSUB PaletteDef
RETURN
END IF
END IF
GOSUB OKCheck
IF ColorChoice=0 THEN
LOCATE 12,2 : COLOR 0,1 : PRINT "Draw";
LOCATE 12,8 : COLOR 1,0 : PRINT "Fill";
ELSE
LOCATE 12,2 : COLOR 1,0 : PRINT "Draw";
LOCATE 12,8 : COLOR 0,1 : PRINT "Fill";
END IF
RETURN
PaletteDef:
IF ColorChoice=0 THEN NewColor=DrawColor ELSE NewColor=FillColor
PATTERN ,Solid%
LINE (0,71)-(240,107),0,bf
COLOR 1,0
LOCATE 9,2 : PRINT "R";
LOCATE 10,2 : PRINT "G";
LOCATE 11,2 : PRINT "B";
LINE (24,70)-(218,78),1,b
LINE (24,80)-(218,88),1,b
LINE (24,90)-(218,98),1,b
LINE (222,70)-(238,98),NewColor,bf
Mode=4
PATTERN ,FillPattern%
RETURN
RGBDef:
Test=MOUSE(0)
x=MOUSE(3) : y=MOUSE(4)
GOSUB ChooseColor
IF ColorChoice=0 THEN NewColor=DrawColor ELSE NewColor=FillColor
GOSUB RGBRegulator
GOSUB OKCheck : IF EndOK=1 THEN EndOK=3
WHILE MOUSE(0)<>0
x=MOUSE(1) : y=MOUSE(2)
IF WINDOW(0)=3 AND x>26 AND x<218 AND y>70 AND y<98 THEN
Colors%(NewColor,INT((y-71)/8.7))=INT((x-26)/12)
GOSUB RGBRegulator
END IF
WEND
RETURN
RGBRegulator:
PATTERN ,Solid%
LINE (25+r*12,71)-(37+r*12,77),0,bf
LINE (25+g*12,81)-(37+g*12,87),0,bf
LINE (25+b*12,91)-(37+b*12,97),0,bf
r=Colors%(NewColor,0)
g=Colors%(NewColor,1)
b=Colors%(NewColor,2)
LINE (25+r*12,71)-(37+r*12,77),1,bf
LINE (25+g*12,81)-(37+g*12,87),1,bf
LINE (25+b*12,91)-(37+b*12,97),1,bf
PALETTE NewColor,r/16,g/16,b/16
LINE (222,70)-(238,98),NewColor,bf
PATTERN ,FillPattern%
RETURN
ChooseColor:
IF WINDOW(0)=3 AND x<240 AND y<(2^(Colors+1)) THEN
fx=INT(x/30) : fy = INT(y/16)
IF ColorChoice=0 THEN
DrawColor=fy*8+fx
ELSE
FillColor=fy*8+fx
END IF
END IF
RETURN
OKCheck:
IF x>190 AND x<230 AND y>109 AND y<132 THEN
PATTERN ,Solid%
PAINT (192,111),3,1 : EndOK=1
PATTERN ,FillPattern%
END IF
RETURN
ColorDone:
MENU 2,0,1 : Mode=1
WINDOW CLOSE 3
WINDOW OUTPUT 2
RETURN
PatternEditor:
MOUSE OFF : MENU OFF
EndOK=0
WINDOW 4,"Fill Patterns",(54,30)-(300,130),18,1
LINE (0,0)-(132,66),3,b
FOR x=0 TO 2
FOR y=0 TO 2
FOR i=0 TO 7: FillPattern%(i)=AllPatterns%(y*3+x,i) : NEXT i
PATTERN ,FillPattern%
LINE (144+x*34,y*25)-(175+x*34,23+y*25),1,bf
NEXT y
NEXT x
GOSUB MarkPattern
LINE (5,68)-(65,82),1,b
LOCATE 9,2 : PRINT "Clear";
LINE (75,68)-(135,82),1,b
LOCATE 9,9: PRINT "Inv.";
LINE (5,85)-(65,100),1,b
LOCATE 11,2 : PRINT "Load";
LINE (75,85)-(135,100),1,b
LOCATE 11,9: PRINT "Save";
LINE (162,77)-(222,92),1,b
LOCATE 10,19 : PRINT "OK";
FOR i=0 TO 7 : FillPattern%(i)=AllPatterns%(PtrnNumber,i) : NEXT i
GOSUB DrawPattern
MENU ON : MOUSE ON
RETURN
DefinePattern:
Test=MOUSE(0)
x=MOUSE(3) : y=MOUSE(4)
IF WINDOW(0)=4 AND x<132 AND y<66 THEN
px=INT(x/8.25) : py=INT(y/8.25)
Bit=FillPattern%(py) AND 2^(15-px)
IF Bit=0 THEN
FillPattern=FillPattern%(py) OR 2^(15-px)
ELSE
FillPattern=FillPattern%(py) AND (65535&-2^(15-px))
END IF
IF FillPattern>32767 THEN FillPattern=FillPattern-65536&
FillPattern%(py)=FillPattern
PATTERN ,Solid%
LINE (px*8+4,py*8+2)-(px*8+9,py*8+8),-(Bit=0),bf
PATTERN ,FillPattern%
y1=INT(PtrnNumber/3) : x1=PtrnNumber-y1*3
LINE (144+x1*34,y1*25)-(175+x1*34,23+y1*25),1,bf
FOR i=0 TO 7 : AllPatterns%(PtrnNumber,i)=FillPattern%(i) : NEXT i
RETURN
END IF
IF WINDOW(0)=4 AND x>142 AND x<244 AND y<75 THEN
px=INT((x-143)/34) : py=INT(y/25)
IF px+py*3=PtrnNumber THEN RETURN
PtrnNumber=px+py*3
FOR i=0 TO 7 : FillPattern%(i)=AllPatterns%(PtrnNumber,i) : NEXT i
GOSUB MarkPattern
GOSUB DrawPattern
PATTERN ,FillPattern%
RETURN
END IF
IF WINDOW(0)=4 AND x<222 AND x>162 AND y<93 AND y>76 THEN
PATTERN ,Solid%
PAINT (164,78),2,1
PATTERN ,FillPattern%
EndOK=2 : RETURN
END IF
IF WINDOW(0)=4 AND x<135 AND y>68 AND y<100 THEN
PATTERN ,Solid%
IF x<66 AND x>4 AND y<82 THEN
PAINT (6,69),2,1
LINE (1,1)-(131,65),0,bf
FOR i=0 TO 7 : AllPatterns%(PtrnNumber,i)=0 : FillPattern%(i)=0 : NEXT
PAINT (6,69),0,1
PATTERN ,FillPattern%
y1=INT(PtrnNumber/3) : x1=PtrnNumber-y1*3
LINE (144+x1*34,y1*25)-(175+x1*34,23+y1*25),1,bf
END IF
IF x<136 AND x>74 AND y<82 THEN
PAINT (76,69),2,1
FOR i=0 TO 7
FillPattern%(i)=FillPattern%(i) XOR &HFFFF
AllPatterns%(PtrnNumber,i)=FillPattern%(i)
NEXT i
GOSUB DrawPattern
PAINT (76,69),0,1
PATTERN ,FillPattern%
y1=INT(PtrnNumber/3) : x1=PtrnNumber-y1*3
LINE (144+x1*34,y1*25)-(175+x1*34,23+y1*25),1,bf
END IF
IF x<66 AND x>4 AND y>84 THEN GOSUB PtrnLoad
IF x<135 AND x>75 AND y>84 THEN GOSUB PtrnSave
END IF
RETURN
MarkPattern:
y1=INT(AltPattern/3) : x1=AltPattern-y1*3
LINE (143+x1*34,y1*25-1)-(176+x1*34,24+y1*25),0,b
y1=INT(PtrnNumber/3) : x1=PtrnNumber-y1*3
LINE (143+x1*34,y1*25-1)-(176+x1*34,24+y1*25),3,b
AltPattern=x1+y1*3
RETURN
DrawPattern:
MOUSE OFF : MENU OFF
PATTERN ,Solid%
LINE (1,1)-(131,65),0,bf
FOR y=0 TO 7
FOR x=0 TO 15
Bit=FillPattern%(y) AND 2^(15-x)
IF Bit<>0 THEN LINE (x*8+4,y*8+2)-(x*8+9,y*8+8),1,bf
NEXT x
NEXT y
PATTERN ,FillPattern%
MOUSE ON : MENU ON
RETURN
PtrnLoad:
MOUSE OFF : MENU OFF
PAINT (6,86),2,1
GOSUB EnterName
IF Nam$="" THEN EndPtrnLoad
OPEN Nam$ FOR INPUT AS 1
FOR x=0 TO 8
FOR y=0 TO 7
AllPatterns%(x,y)=CVI(INPUT$(2,1))
NEXT y
NEXT x
CLOSE 1
EndPtrnLoad:
WINDOW CLOSE 5 : WINDOW 4
PAINT (6,86),0,1
MOUSE ON : MENU ON
FOR x=0 TO 8
FOR y=0 TO 7
FillPattern%(y)=AllPatterns%(x,y)
PATTERN ,FillPattern%
y1=INT(x/3) : x1=x-y1*3
LINE (144+x1*34,y1*25)-(175+x1*34,23+y1*25),1,bf
NEXT y
NEXT x
FOR i=0 TO 7 : FillPattern%(i)=AllPatterns%(PtrnNumber,i) : NEXT
GOSUB DrawPattern
RETURN
PtrnSave:
MOUSE OFF : MENU OFF
PAINT (78,86),2,1
GOSUB EnterName
IF Nam$="" THEN EndPtrnLoad
OPEN Nam$ FOR OUTPUT AS 1
FOR x=0 TO 8
FOR y=0 TO 7
PRINT #1,MKI$(AllPatterns%(x,y));
NEXT y
NEXT x
CLOSE 1
EndPtrnSave:
WINDOW CLOSE 5 : WINDOW 4
PAINT (78,86),0,1
MOUSE ON : MENU ON
RETURN
PatternDone:
MENU 2,0,1 : Mode=1
WINDOW CLOSE 4
WINDOW OUTPUT 2
PATTERN ,FillPattern%
RETURN
DrawLoad:
MENU 2,0,0 : MENU 1,0,0
MENU OFF : MOUSE OFF
GOSUB EnterName
WINDOW CLOSE 5
WINDOW 2
IF Nam$="" THEN EndLoad
OPEN Nam$ FOR INPUT AS 1
Form$=INPUT$(4,1)
Length=CVL(INPUT$(4,1))
IF INPUT$(4,1)<>"ILBM" THEN BEEP : GOTO EndLoad
ReadData:
IF EOF(1) THEN EndLoad
Chunk$=INPUT$(4,1)
Length=CVL(INPUT$(4,1))
IF INT(Length/2)<>(Length/2) THEN Length=Length+1
IF Chunk$="BMHD" THEN BMHeader
IF Chunk$="CMAP" THEN ColorMap
IF Chunk$="BODY" THEN BodyMap
Dummy$=INPUT$(Length,1)
GOTO ReadData
BMHeader:
xd=CVI(INPUT$(2,1))
IF xd>320 THEN EndLoad
yd=CVI(INPUT$(2,1))
IF yd>200 THEN EndLoad
Dummy$=INPUT$(4,1)
BitPlane=ASC(INPUT$(1,1))
Dummy$=INPUT$(11,1)
Addr=PEEKL(WINDOW(8)+4)+8
FOR x=0 TO BitPlane-1
PlaneAddr(x)=PEEKL(Addr+4*x)
NEXT x
GOTO ReadData
ColorMap:
FOR x=0 TO (Length/3)-1
r=(ASC(INPUT$(1,1)) AND 240)/16
g=(ASC(INPUT$(1,1)) AND 240)/16
b=(ASC(INPUT$(1,1)) AND 240)/16
PALETTE x,r/16,g/16,b/16
Colors%(x,0)=r : Colors%(x,1)=g : Colors%(x,2)=b
NEXT x
IF INT(Length/3)<>(Length/3) THEN Dummy$=INPUT$(1,1)
GOTO ReadData
BodyMap:
FOR y1=0 TO 199
FOR b=0 TO BitPlane-1
IF b<Colors THEN
FOR x1=0 TO 9
POKEL PlaneAddr(b)+4*x1+40*y1,CVL(INPUT$(4,1))
NEXT x1
ELSE
Dummy$=INPUT$(40,1)
END IF
NEXT b
NEXT y1
GOTO ReadData
EndLoad:
CLOSE 1
MENU ON : MOUSE ON
MENU 1,0,1 : MENU 2,0,1
RETURN
DrawSave:
MENU 2,0,0 : MENU 1,0,0
MENU OFF : MOUSE OFF
GOSUB EnterName
WINDOW CLOSE 5
WINDOW 2
IF Nam$="" THEN EndSave
OPEN Nam$ FOR OUTPUT AS 1 LEN=FRE(0)-500
PRINT #1,"FORM";
PRINT #1,MKL$(156+8000*Colors);
PRINT #1,"ILBM";
PRINT #1,"BMHD";MKL$(20);
PRINT #1,MKI$(320);MKI$(200);
PRINT #1,MKL$(0);
PRINT #1,CHR$(Colors);
PRINT #1,CHR$(0);MKI$(0);MKI$(0);
PRINT #1,CHR$(10);CHR$(11);
PRINT #1,MKI$(320);MKI$(200);
PRINT #1,"CMAP";MKL$(96);
FOR x=0 TO 31
PRINT #1,CHR$(Colors%(x,0)*16);
PRINT #1,CHR$(Colors%(x,1)*16);
PRINT #1,CHR$(Colors%(x,2)*16);
NEXT x
PRINT #1,"BODY";MKL$(8000*Colors);
Addr=PEEKL(WINDOW(8)+4)+8
FOR x=0 TO Colors-1
PlaneAddr(x)=PEEKL(Addr+4*x)
NEXT x
FOR y1=0 TO 199
FOR b=0 TO Colors-1
FOR x1=0 TO 9
PRINT#1,MKL$(PEEKL(PlaneAddr(b)+4*x1+40*y1));
NEXT x1
NEXT b
PAddr=PlaneAddr(0)+40*y1
POKE PAddr,PEEK(PAddr) AND 63
POKE PAddr+39,PEEK(PAddr+39) AND 252
NEXT y1
PRINT #1,"CAMG";MKL$(4);
PRINT #1,MKL$(16384);
CLOSE 1
EndSave:
MENU ON : MOUSE ON
MENU 1,0,1 : MENU 2,0,1
RETURN
EnterName:
Altname$=Nam$
WINDOW 5,"Enter Name:",(0,80)-(311,88),0,1
CLS
LINE INPUT Nam$
IF Nam$= "=" OR Nam$="*" THEN Nam$=Altname$
RETURN
Query:
MENU 1,0,0 : MENU 2,0,0
MENU OFF : MOUSE OFF
WINDOW 5,"CAUTION!",(43,70)-(270,120),0,1
COLOR 0,1 : CLS : LOCATE 2,2
PRINT "Do you really want to"
PRINT " lose your picture?"
PATTERN ,Solid%
LOCATE 5,10 : PRINT "Yes";
LOCATE 5,17 : PRINT "No";
LINE (77,31)-(127,46),0,b
LINE (145,31)-(195,46),0,b
SOUND 880,6,100
Pause:
Test=MOUSE(0)
WHILE MOUSE(0)=0
x=MOUSE(1) : y=MOUSE(2)
WEND
IF (y<46 AND y>31) THEN
IF (x<127 AND x>77) THEN PAINT (79,33),3,0 : OK=1 : GOTO EndQuery
IF (x<195 AND x>145) THEN PAINT (147,33),3,0 : OK=0 : GOTO EndQuery
END IF
GOTO Pause
EndQuery:
MENU ON : MOUSE ON : MENU 1,0,1 : MENU 2,0,1
WINDOW CLOSE 5 : WINDOW 2
RETURN
EndIt:
MENU RESET
SCREEN CLOSE 1
END